系統設置

安裝需要的packages

packages = c("readr", "dplyr", "jiebaR", "tidyr", "tidytext", "igraph", "topicmodels", "ggplot2", "stringr")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)

載入packages

library(readr)
library(dplyr)
library(jiebaR)
library(tidyr)
library(tidytext)
library(igraph)
library(topicmodels)
library(stringr)
library(ggplot2)
library(tibble)
library(ggrepel)

讀取資料

載入12月PTT政黑版資料

# 文章資料
posts <- read_csv("./12_content.csv")
posts
# 回覆資料
reviews <- read_csv("./12_comment.csv")
reviews
# 選取需要的欄位
reviews <- reviews %>%
      select(canonical_url, commenter, reaction, text)
reviews

資料預覽

posts$date <- as.Date(posts$date)

posts %>% 
  group_by(date) %>%
  summarise(count = n()) %>%
  ggplot(aes(date,count)) +
    geom_line(color="blue", size=1) +
    theme_classic()

發文者數量

length(unique(posts$poster))
[1] 3908

回覆者數量

length(unique(reviews$commenter))
[1] 18830

總共有參與的人數

allPoster <- c(posts$poster, reviews$commenter)
length(unique(allPoster))
[1] 20747

整理所有參與人

# 整理所有出現過得使用者
# 如果它曾發過文的話就標註他爲poster
# 如果沒有發過文的話則標註他爲replyer
userList <- data.frame(user=unique(allPoster)) %>%
              mutate(type=ifelse(user%in%posts$poster, "poster", "replyer"))

userList["user"]<-apply(userList["user"], 1:length(userList["user"]), function(x) gsub(" .*","", x))
userList

建立社群網路圖

將原文與回覆Join起來

# 把原文與回覆依據url innerJoin起來,這邊直接讀之前join的檔案
posts_Reviews <- read_csv("./post_review.csv") 
#posts_Reviews <- merge(x = posts, y = reviews, by = c("canonical_url"))
posts_Reviews

篩選欄位

# 取出 commenter(回覆者)、poster(發文者)、canonical_url(文章連結) 、title.x 四個欄位
link <- posts_Reviews %>%
      select(commenter,poster, canonical_url, title.x)
link

建立網路關係

reviewNetwork <- graph_from_data_frame(d=link, directed=F)
reviewNetwork
IGRAPH 3601ea4 UN-- 19263 2201825 -- 
+ attr: name (v/c), canonical_url (e/c), title.x (e/c)
+ edges from 3601ea4 (vertex names):
 [1] want150   --oftisa       ulycess   --oftisa       want150   --oftisa      
 [4] DarkKnight--oftisa       sentaifans--radiohead56  Marchosias--radiohead56 
 [7] bluecup   --radiohead56  sentaifans--radiohead56  sentaifans--radiohead56 
[10] sentaifans--sentaifans   sentaifans--GameGyu      sentaifans--sentaifans  
[13] sentaifans--GameGyu      sentaifans--Cosmoswalker sentaifans--hwyi        
[16] sentaifans--GameGyu      sentaifans--fdtu0928     sentaifans--GameGyu     
[19] sentaifans--GameGyu      sentaifans--sentaifans   sentaifans--sentaifans  
[22] sentaifans--impixels     sentaifans--GameGyu      sentaifans--bluecup     
+ ... omitted several edges

調整參數並繪製網路圖

# 調整點點的大小和線的粗細,並不顯示使用者賬號。
# 點太多邊太密,必須要篩選資料,這邊就先不畫圖,反正也看不出什麼
set.seed(487)
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)

V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "blue")

#plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2, vertex.label = NA)

資料篩選

挑出ㄧ天的文章和它的回覆

link <- posts_Reviews[posts_Reviews$date.x == as.Date("2019-12-04"), ]
link["poster"]<-apply(link["poster"], 1:length(link["poster"]), function(x) gsub(" .*","", x))
link["commenter"]<-apply(link["commenter"], 1:length(link["commenter"]), function(x) gsub(" .*","", x))
link <- select(link, commenter, poster, canonical_url) %>% unique()
link

過濾圖中的點(v)

# 這邊要篩選link中有出現的使用者
# 因爲如果userList(igraph中graph_from_data_frame的v參數吃的那個東西)中出現了沒有在link中出現的使用者也會被igraph畫上去,圖片就會變得沒有意義
filtered_user <- userList %>%
          filter(user%in%link$commenter | user%in%link$poster) %>%
          arrange(desc(type)) %>% unique()
filtered_user
# 為了觀察方便及找出活躍鄉民,先移除互動量小於200的用戶
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=T)
reviewNetwork <- delete.vertices(reviewNetwork, V(reviewNetwork)[ degree(reviewNetwork) < 200])
reviewNetwork
IGRAPH 59a7dc4 DN-B 8 32 -- 
+ attr: name (v/c), type (v/c), canonical_url (e/c)
+ edges from 59a7dc4 (vertex names):
 [1] kero2377    ->cutbear123   buoyant0828 ->cutbear123   kero2377    ->kero2377    
 [4] kero2377    ->kero2377     Sinreigensou->kero2377     howiekuohr  ->kero2377    
 [7] kero2377    ->kero2377     bankingpaul ->howiekuohr   buoyant0828 ->bankingpaul 
[10] buoyant0828 ->jacklyl      kero2377    ->kero2377     buoyant0828 ->kero2377    
[13] howiekuohr  ->jacklyl      kero2377    ->jacklyl      howiekuohr  ->kero2377    
[16] cutbear123  ->kero2377     cutbear123  ->jacklyl      howiekuohr  ->jacklyl     
[19] kero2377    ->kero2377     howiekuohr  ->kero2377     howiekuohr  ->kero2377    
[22] cutbear123  ->kero2377     kero2377    ->howiekuohr   Sinreigensou->Sinreigensou
+ ... omitted several edges
# 繪圖
set.seed(487)
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)

V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "blue")

plot(reviewNetwork, vertex.size=8, edge.arrow.size=.4, vertex.label=V(reviewNetwork)$label, vertex.label.font=2)

legend("bottomright", c("author","reviewer"), pch=21,
  col="#777777", pt.bg=c("gold","blue"), pt.cex=1, cex=1)

我們可以看到基本的使用者關係,但是我們希望能夠將更進階的資訊視覺化。
例如:使用者經常參與的文章種類,或是使用者在該社群網路中是否受到歡迎。

主題分類

前處理

# 文章斷句
ptt_meta <- posts %>%
              mutate(sentence=gsub("[\n]{2,}", "。", text))
# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
ptt_sentences <- strsplit(ptt_meta$sentence,"[。!;?!?;]")
# 將每句句子,與他所屬的文章連結配對起來,整理成一個dataframe
ptt_sentences <- data.frame(
                        artUrl = rep(ptt_meta$canonical_url, sapply(ptt_sentences, length)), 
                        sentence = unlist(ptt_sentences)
                      ) %>%
                      filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
ptt_sentences$sentence <- as.character(ptt_sentences$sentence)
ptt_sentences
Read 44 items
Read 1225 items
[1] TRUE
## 清理斷詞結果
# 挑出總出現次數大於3的字
reserved_word <- tokens %>% 
  group_by(word) %>% 
  count() %>% 
  filter(n > 3) %>% 
  unlist()

ptt_removed <- tokens %>% 
  filter(word %in% reserved_word)

ptt_dtm <- ptt_removed %>% cast_dtm(artUrl, word, count)
ptt_dtm
<<DocumentTermMatrix (documents: 19991, terms: 9623)>>
Non-/sparse entries: 410782/191962611
Sparsity           : 100%
Maximal term length: 42
Weighting          : term frequency (tf)

LDA 主題分析

# LDA分主題
rowTotals <- apply(ptt_dtm , 1, sum) #Find the sum of words in each Document
ptt_dtm <- ptt_dtm[rowTotals> 0, ]

ptt_lda <- LDA(ptt_dtm, k = 6, control = list(seed = 1000))
# 看各群的常用詞彙
tidy(ptt_lda, matrix = "beta") %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  mutate(topic = as.factor(topic),
         term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = topic)) +
  geom_col(show.legend = FALSE) +
  theme(text = element_text(family = 'TW-Kai')) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered()

# 使用LDA預測每篇文章的主題
# 在tidy function中使用參數"gamma"來取得 theta矩陣。
ptt_topics <- tidy(ptt_lda, matrix="gamma") %>% 
                  group_by(document) %>%
                  top_n(1, wt=gamma)
ptt_topics

LDA主題進行視覺化

# 把文章資訊和主題join起來
posts_Reviews <- merge(x = posts_Reviews, y = ptt_topics, by.x = "canonical_url", by.y="document")
posts_Reviews
# 挑選出2019/12的文章,
# 篩選有在15篇以上文章回覆者,
# 欄位只取:commenter(評論者), poster(發文者), canonical_url(文章連結), title.x(主題), reaction(推噓)
link <- posts_Reviews %>%
      filter(reaction !="→") %>%
      group_by(commenter, canonical_url) %>% 
      filter(n()>15) %>% 
      ungroup() %>% 
      filter(topic == 1 | topic == 6) %>% 
      select(commenter, poster, canonical_url, title.x, reaction) %>% 
      unique()

link["poster"]<-apply(link["poster"], 1:length(link["poster"]), function(x) gsub(" .*","", x))
link["commenter"]<-apply(link["commenter"], 1:length(link["commenter"]), function(x) gsub(" .*","", x))
link <- unique(link)
link
# 篩選link中有出現的使用者

filtered_user <- userList %>%
          filter(user%in%link$commenter | user%in%link$poster) %>%
          arrange(desc(type)) %>% unique()

filtered_user["user"] <- apply(filtered_user["user"], 1:length(filtered_user["user"]), function(x) gsub(" .*","", x))
filtered_user <- unique(filtered_user)
filtered_user
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=T)

# 刪除degree < 10 的用戶
reviewNetwork <- delete.vertices(reviewNetwork, V(reviewNetwork)[ degree(reviewNetwork) < 10])

# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")

# 依據使用者反應對邊進行上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$reaction == "推", "lightgreen", "palevioletred")

# 畫出社群網路圖
set.seed(5431)
plot(reviewNetwork, vertex.size=5, edge.arrow.size=.2, edge.width=.4,
     vertex.label= NA, vertex.label.font=2)

# 加入標示
legend("bottomright", c("author","reviewer"), pch=21,
  col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("Like","Boo"), 
       col=c("lightgreen","palevioletred"), lty=1, cex=1)

# 畫出社群網路圖,同上,只是有label
set.seed(5431)
plot(reviewNetwork, vertex.size=5, edge.arrow.size=.2, edge.width=.4,
     vertex.label= ifelse(degree(reviewNetwork) > 20, V(reviewNetwork)$label, NA), vertex.label.font=2)

# 加入標示
legend("bottomright", c("author","reviewer"), pch=21,
  col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("Like","Boo"), 
       col=c("lightgreen","palevioletred"), lty=1, cex=1)

LS0tCnRpdGxlOiDlvp4yMDIw57i957Wx5aSn6YG45rSe5oKJUFRU6Ly/6KuW55Sf5oWLCmF1dGhvcjog5ZyL5a625a6J5YWo56ys5LqU57WECm91dHB1dDogCiAgaHRtbF9ub3RlYm9vazoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBzbW9vdGhfc2Nyb2xsOiB0cnVlCiAgICB0aGVtZTogc3BhY2VsYWIKZGF0ZTogQXVnIDEsIDIwMjAKLS0tCgojIOezu+e1seioree9rgojIyMg5a6J6KOd6ZyA6KaB55qEcGFja2FnZXMKYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KcGFja2FnZXMgPSBjKCJyZWFkciIsICJkcGx5ciIsICJqaWViYVIiLCAidGlkeXIiLCAidGlkeXRleHQiLCAiaWdyYXBoIiwgInRvcGljbW9kZWxzIiwgImdncGxvdDIiLCAic3RyaW5nciIpCmV4aXN0aW5nID0gYXMuY2hhcmFjdGVyKGluc3RhbGxlZC5wYWNrYWdlcygpWywxXSkKZm9yKHBrZyBpbiBwYWNrYWdlc1shKHBhY2thZ2VzICVpbiUgZXhpc3RpbmcpXSkgaW5zdGFsbC5wYWNrYWdlcyhwa2cpCmBgYAoKIyMjIOi8ieWFpXBhY2thZ2VzCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkocmVhZHIpCmxpYnJhcnkoZHBseXIpCmxpYnJhcnkoamllYmFSKQpsaWJyYXJ5KHRpZHlyKQpsaWJyYXJ5KHRpZHl0ZXh0KQpsaWJyYXJ5KGlncmFwaCkKbGlicmFyeSh0b3BpY21vZGVscykKbGlicmFyeShzdHJpbmdyKQpsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkodGliYmxlKQpsaWJyYXJ5KGdncmVwZWwpCmBgYAoKIyDoroDlj5bos4fmlpkKCiMjIyDovInlhaUxMuaciFBUVOaUv+m7keeJiOizh+aWmQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQojIOaWh+eroOizh+aWmQpwb3N0cyA8LSByZWFkX2NzdigiLi8xMl9jb250ZW50LmNzdiIpCnBvc3RzCmBgYAoKCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CiMg5Zue6KaG6LOH5paZCnJldmlld3MgPC0gcmVhZF9jc3YoIi4vMTJfY29tbWVudC5jc3YiKQpyZXZpZXdzCmBgYAoKYGBge3J9CiMg6YG45Y+W6ZyA6KaB55qE5qyE5L2NCnJldmlld3MgPC0gcmV2aWV3cyAlPiUKICAgICAgc2VsZWN0KGNhbm9uaWNhbF91cmwsIGNvbW1lbnRlciwgcmVhY3Rpb24sIHRleHQpCnJldmlld3MKYGBgCgojIOizh+aWmemgkOimvQpgYGB7cn0KcG9zdHMkZGF0ZSA8LSBhcy5EYXRlKHBvc3RzJGRhdGUpCgpwb3N0cyAlPiUgCiAgZ3JvdXBfYnkoZGF0ZSkgJT4lCiAgc3VtbWFyaXNlKGNvdW50ID0gbigpKSAlPiUKICBnZ3Bsb3QoYWVzKGRhdGUsY291bnQpKSArCiAgICBnZW9tX2xpbmUoY29sb3I9ImJsdWUiLCBzaXplPTEpICsKICAgIHRoZW1lX2NsYXNzaWMoKQpgYGAKCiMjIyDnmbzmlofogIXmlbjph48KYGBge3J9Cmxlbmd0aCh1bmlxdWUocG9zdHMkcG9zdGVyKSkKYGBgCgojIyMg5Zue6KaG6ICF5pW46YePCmBgYHtyfQpsZW5ndGgodW5pcXVlKHJldmlld3MkY29tbWVudGVyKSkKYGBgCgojIyMg57i95YWx5pyJ5Y+D6IiH55qE5Lq65pW4CmBgYHtyfQphbGxQb3N0ZXIgPC0gYyhwb3N0cyRwb3N0ZXIsIHJldmlld3MkY29tbWVudGVyKQpsZW5ndGgodW5pcXVlKGFsbFBvc3RlcikpCmBgYAoKIyMjIOaVtOeQhuaJgOacieWPg+iIh+S6ugpgYGB7cn0KIyDmlbTnkIbmiYDmnInlh7rnj77pgY7lvpfkvb/nlKjogIUKIyDlpoLmnpzlroPmm77nmbzpgY7mlofnmoToqbHlsLHmqJnoqLvku5bniLJwb3N0ZXIKIyDlpoLmnpzmspLmnInnmbzpgY7mlofnmoToqbHliYfmqJnoqLvku5bniLJyZXBseWVyCnVzZXJMaXN0IDwtIGRhdGEuZnJhbWUodXNlcj11bmlxdWUoYWxsUG9zdGVyKSkgJT4lCiAgICAgICAgICAgICAgbXV0YXRlKHR5cGU9aWZlbHNlKHVzZXIlaW4lcG9zdHMkcG9zdGVyLCAicG9zdGVyIiwgInJlcGx5ZXIiKSkKCnVzZXJMaXN0WyJ1c2VyIl08LWFwcGx5KHVzZXJMaXN0WyJ1c2VyIl0sIDE6bGVuZ3RoKHVzZXJMaXN0WyJ1c2VyIl0pLCBmdW5jdGlvbih4KSBnc3ViKCIgLioiLCIiLCB4KSkKdXNlckxpc3QKYGBgCgojIOW7uueri+ekvue+pOe2sui3r+WclgojIyMg5bCH5Y6f5paH6IiH5Zue6KaGSm9pbui1t+S+hgpgYGB7ciBtZXNzYWdlID0gRkFMU0UsIHdhcm5pbmc9RkFMU0V9CiMg5oqK5Y6f5paH6IiH5Zue6KaG5L6d5pOadXJsIGlubmVySm9pbui1t+S+hu+8jOmAmemCiuebtOaOpeiugOS5i+WJjWpvaW7nmoTmqpTmoYgKcG9zdHNfUmV2aWV3cyA8LSByZWFkX2NzdigiLi9wb3N0X3Jldmlldy5jc3YiKSAKI3Bvc3RzX1Jldmlld3MgPC0gbWVyZ2UoeCA9IHBvc3RzLCB5ID0gcmV2aWV3cywgYnkgPSBjKCJjYW5vbmljYWxfdXJsIikpCnBvc3RzX1Jldmlld3MKYGBgCgojIyMg56+p6YG45qyE5L2NCmBgYHtyfQojIOWPluWHuiBjb21tZW50ZXIo5Zue6KaG6ICFKeOAgXBvc3RlcijnmbzmlofogIUp44CBY2Fub25pY2FsX3VybCjmlofnq6DpgKPntZApIOOAgXRpdGxlLngg5Zub5YCL5qyE5L2NCmxpbmsgPC0gcG9zdHNfUmV2aWV3cyAlPiUKICAgICAgc2VsZWN0KGNvbW1lbnRlcixwb3N0ZXIsIGNhbm9uaWNhbF91cmwsIHRpdGxlLngpCmxpbmsKYGBgCgojIyMg5bu656uL57ay6Lev6Zec5L+CCmBgYHtyfQpyZXZpZXdOZXR3b3JrIDwtIGdyYXBoX2Zyb21fZGF0YV9mcmFtZShkPWxpbmssIGRpcmVjdGVkPUYpCnJldmlld05ldHdvcmsKYGBgCgojIyMg6Kq/5pW05Y+D5pW45Lim57mq6KO957ay6Lev5ZyWCmBgYHtyIG1lc3NhZ2UgPSBGQUxTRSwgd2FybmluZz1GQUxTRX0KIyDoqr/mlbTpu57pu57nmoTlpKflsI/lkoznt5rnmoTnspfntLDvvIzkuKbkuI3poa/npLrkvb/nlKjogIXos6zomZ/jgIIKIyDpu57lpKrlpJrpgorlpKrlr4bvvIzlv4XpoIjopoHnr6npgbjos4fmlpnvvIzpgJnpgorlsLHlhYjkuI3nlavlnJbvvIzlj43mraPkuZ/nnIvkuI3lh7rku4DpurwKc2V0LnNlZWQoNDg3KQpsYWJlbHMgPC0gZGVncmVlKHJldmlld05ldHdvcmspClYocmV2aWV3TmV0d29yaykkbGFiZWwgPC0gbmFtZXMobGFiZWxzKQoKVihyZXZpZXdOZXR3b3JrKSRjb2xvciA8LSBpZmVsc2UoVihyZXZpZXdOZXR3b3JrKSR0eXBlPT0icG9zdGVyIiwgImdvbGQiLCAiYmx1ZSIpCgojcGxvdChyZXZpZXdOZXR3b3JrLCB2ZXJ0ZXguc2l6ZT0yLCBlZGdlLmFycm93LnNpemU9LjIsIHZlcnRleC5sYWJlbCA9IE5BKQpgYGAKCiMg6LOH5paZ56+p6YG4CiMjIyDmjJHlh7rjhKflpKnnmoTmlofnq6DlkozlroPnmoTlm57opoYKYGBge3J9CmxpbmsgPC0gcG9zdHNfUmV2aWV3c1twb3N0c19SZXZpZXdzJGRhdGUueCA9PSBhcy5EYXRlKCIyMDE5LTEyLTA0IiksIF0KbGlua1sicG9zdGVyIl08LWFwcGx5KGxpbmtbInBvc3RlciJdLCAxOmxlbmd0aChsaW5rWyJwb3N0ZXIiXSksIGZ1bmN0aW9uKHgpIGdzdWIoIiAuKiIsIiIsIHgpKQpsaW5rWyJjb21tZW50ZXIiXTwtYXBwbHkobGlua1siY29tbWVudGVyIl0sIDE6bGVuZ3RoKGxpbmtbImNvbW1lbnRlciJdKSwgZnVuY3Rpb24oeCkgZ3N1YigiIC4qIiwiIiwgeCkpCmxpbmsgPC0gc2VsZWN0KGxpbmssIGNvbW1lbnRlciwgcG9zdGVyLCBjYW5vbmljYWxfdXJsKSAlPiUgdW5pcXVlKCkKbGluawpgYGAKCiMjIyDpgY7mv77lnJbkuK3nmoTpu54odikKYGBge3J9CiMg6YCZ6YKK6KaB56+p6YG4bGlua+S4reacieWHuuePvueahOS9v+eUqOiAhQojIOWboOeIsuWmguaenHVzZXJMaXN077yIaWdyYXBo5LitZ3JhcGhfZnJvbV9kYXRhX2ZyYW1l55qEduWPg+aVuOWQg+eahOmCo+WAi+adseilv++8ieS4reWHuuePvuS6huaykuacieWcqGxpbmvkuK3lh7rnj77nmoTkvb/nlKjogIXkuZ/mnIPooqtpZ3JhcGjnlavkuIrljrvvvIzlnJbniYflsLHmnIPororlvpfmspLmnInmhI/nvqkKZmlsdGVyZWRfdXNlciA8LSB1c2VyTGlzdCAlPiUKICAgICAgICAgIGZpbHRlcih1c2VyJWluJWxpbmskY29tbWVudGVyIHwgdXNlciVpbiVsaW5rJHBvc3RlcikgJT4lCiAgICAgICAgICBhcnJhbmdlKGRlc2ModHlwZSkpICU+JSB1bmlxdWUoKQpmaWx0ZXJlZF91c2VyCmBgYAoKYGBge3J9CiMg54K65LqG6KeA5a+f5pa55L6/5Y+K5om+5Ye65rS76LqN6YSJ5rCR77yM5YWI56e76Zmk5LqS5YuV6YeP5bCP5pa8MjAw55qE55So5oi2CnJldmlld05ldHdvcmsgPC0gZ3JhcGhfZnJvbV9kYXRhX2ZyYW1lKGQ9bGluaywgdj1maWx0ZXJlZF91c2VyLCBkaXJlY3RlZD1UKQpyZXZpZXdOZXR3b3JrIDwtIGRlbGV0ZS52ZXJ0aWNlcyhyZXZpZXdOZXR3b3JrLCBWKHJldmlld05ldHdvcmspWyBkZWdyZWUocmV2aWV3TmV0d29yaykgPCAyMDBdKQpyZXZpZXdOZXR3b3JrCmBgYAoKYGBge3J9CiMg57mq5ZyWCnNldC5zZWVkKDQ4NykKbGFiZWxzIDwtIGRlZ3JlZShyZXZpZXdOZXR3b3JrKQpWKHJldmlld05ldHdvcmspJGxhYmVsIDwtIG5hbWVzKGxhYmVscykKClYocmV2aWV3TmV0d29yaykkY29sb3IgPC0gaWZlbHNlKFYocmV2aWV3TmV0d29yaykkdHlwZT09InBvc3RlciIsICJnb2xkIiwgImJsdWUiKQoKcGxvdChyZXZpZXdOZXR3b3JrLCB2ZXJ0ZXguc2l6ZT04LCBlZGdlLmFycm93LnNpemU9LjQsIHZlcnRleC5sYWJlbD1WKHJldmlld05ldHdvcmspJGxhYmVsLCB2ZXJ0ZXgubGFiZWwuZm9udD0yKQoKbGVnZW5kKCJib3R0b21yaWdodCIsIGMoImF1dGhvciIsInJldmlld2VyIiksIHBjaD0yMSwKICBjb2w9IiM3Nzc3NzciLCBwdC5iZz1jKCJnb2xkIiwiYmx1ZSIpLCBwdC5jZXg9MSwgY2V4PTEpCmBgYAoKPiDmiJHlgJHlj6/ku6XnnIvliLDln7rmnKznmoTkvb/nlKjogIXpl5zkv4LvvIzkvYbmmK/miJHlgJHluIzmnJvog73lpKDlsIfmm7TpgLLpmo7nmoTos4foqIroppboprrljJbjgII8YnI+CuS+i+Wmgu+8muS9v+eUqOiAhee2k+W4uOWPg+iIh+eahOaWh+eroOeorumhnu+8jOaIluaYr+S9v+eUqOiAheWcqOipsuekvue+pOe2sui3r+S4reaYr+WQpuWPl+WIsOatoei/juOAggoKCiMg5Li76aGM5YiG6aGeCgojIyMg5YmN6JmV55CGCmBgYHtyfQojIOaWh+eroOaWt+WPpQpwdHRfbWV0YSA8LSBwb3N0cyAlPiUKICAgICAgICAgICAgICBtdXRhdGUoc2VudGVuY2U9Z3N1YigiW1xuXXsyLH0iLCAi44CCIiwgdGV4dCkpCiMg5Lul5YWo5b2i5oiW5Y2K5b2iIOmpmuatjuiZn+OAgeWVj+iZn+OAgeWIhuiZnyDku6Xlj4og5YWo5b2i5Y+l6JmfIOeIsuS+neaTmumAsuihjOaWt+WPpQpwdHRfc2VudGVuY2VzIDwtIHN0cnNwbGl0KHB0dF9tZXRhJHNlbnRlbmNlLCJb44CC77yB77yb77yfIT87XSIpCiMg5bCH5q+P5Y+l5Y+l5a2Q77yM6IiH5LuW5omA5bGs55qE5paH56ug6YCj57WQ6YWN5bCN6LW35L6G77yM5pW055CG5oiQ5LiA5YCLZGF0YWZyYW1lCnB0dF9zZW50ZW5jZXMgPC0gZGF0YS5mcmFtZSgKICAgICAgICAgICAgICAgICAgICAgICAgYXJ0VXJsID0gcmVwKHB0dF9tZXRhJGNhbm9uaWNhbF91cmwsIHNhcHBseShwdHRfc2VudGVuY2VzLCBsZW5ndGgpKSwgCiAgICAgICAgICAgICAgICAgICAgICAgIHNlbnRlbmNlID0gdW5saXN0KHB0dF9zZW50ZW5jZXMpCiAgICAgICAgICAgICAgICAgICAgICApICU+JQogICAgICAgICAgICAgICAgICAgICAgZmlsdGVyKCFzdHJfZGV0ZWN0KHNlbnRlbmNlLCByZWdleCgiXihcdHxcbnwgKSokIikpKQpwdHRfc2VudGVuY2VzJHNlbnRlbmNlIDwtIGFzLmNoYXJhY3RlcihwdHRfc2VudGVuY2VzJHNlbnRlbmNlKQpwdHRfc2VudGVuY2VzCmBgYAoKYGBge3IgbWVzc2FnZSA9IEZBTFNFLCB3YXJuaW5nPUZBTFNFLCBlY2hvPUZBTFNFfQojIyDmlofnq6DmlrfoqZ4KIyBsb2FkIGhhdGVfbGV4aWNvbgpoYXRlX2xleGljb24gPC0gc2NhbihmaWxlID0gIi4vVzEyL2RpY3QvaGF0ZV9sZXhpY29uLnR4dCIsIHdoYXQ9Y2hhcmFjdGVyKCksc2VwPSdcbicsIAogICAgICAgICAgICAgICAgICAgZW5jb2Rpbmc9J3V0Zi04JyxmaWxlRW5jb2Rpbmc9J3V0Zi04JykKIyBsb2FkIHN0b3Agd29yZHMKc3RvcF93b3JkcyA8LSBzY2FuKGZpbGUgPSAiLi9XMTIvZGljdC9zdG9wX3dvcmRzLnR4dCIsIHdoYXQ9Y2hhcmFjdGVyKCksc2VwPSdcbicsIAogICAgICAgICAgICAgICAgICAgZW5jb2Rpbmc9J3V0Zi04JyxmaWxlRW5jb2Rpbmc9J3V0Zi04JykKIyDkvb/nlKjpu5joqo3lj4PmlbjliJ3lp4vljJbkuIDlgIvmlrfoqZ7lvJXmk44KamllYmFfdG9rZW5pemVyID0gd29ya2VyKCkKIyDkvb/nlKjlj6PnvanlrZflhbjph43mlrDmlrfoqZ4KbmV3X3VzZXJfd29yZChqaWViYV90b2tlbml6ZXIsIGMoaGF0ZV9sZXhpY29uKSkKIyB0b2tlbml6ZSBmdW5jdGlvbgpjaGlfdG9rZW5pemVyIDwtIGZ1bmN0aW9uKHQpIHsKICBsYXBwbHkodCwgZnVuY3Rpb24oeCkgewogICAgaWYobmNoYXIoeCk+MSl7CiAgICAgIHRva2VucyA8LSBzZWdtZW50KHgsIGppZWJhX3Rva2VuaXplcikKICAgICAgdG9rZW5zIDwtIHRva2Vuc1shdG9rZW5zICVpbiUgc3RvcF93b3Jkc10KICAgICAgIyDljrvmjonlrZfkuLLplbfluqbniLIx55qE6Kme5b2ZCiAgICAgIHRva2VucyA8LSB0b2tlbnNbbmNoYXIodG9rZW5zKT4xXQogICAgICByZXR1cm4odG9rZW5zKQogICAgfQogIH0pCn0KdG9rZW5zIDwtIHB0dF9zZW50ZW5jZXMgJT4lCiAgdW5uZXN0X3Rva2Vucyh3b3JkLCBzZW50ZW5jZSwgdG9rZW49Im5ncmFtcyIsIG4gPSAxKSAlPiUKICBmaWx0ZXIoIXN0cl9kZXRlY3Qod29yZCwgcmVnZXgoIlswLTlhLXpBLVpdIikpKSAlPiUKICBjb3VudChhcnRVcmwsIHdvcmQpICU+JQogIHJlbmFtZShjb3VudD1uKQp0b2tlbnMKYGBgCgpgYGB7cn0KIyMg5riF55CG5pa36Kme57WQ5p6cCiMg5oyR5Ye657i95Ye654++5qyh5pW45aSn5pa8M+eahOWtlwpyZXNlcnZlZF93b3JkIDwtIHRva2VucyAlPiUgCiAgZ3JvdXBfYnkod29yZCkgJT4lIAogIGNvdW50KCkgJT4lIAogIGZpbHRlcihuID4gMykgJT4lIAogIHVubGlzdCgpCgpwdHRfcmVtb3ZlZCA8LSB0b2tlbnMgJT4lIAogIGZpbHRlcih3b3JkICVpbiUgcmVzZXJ2ZWRfd29yZCkKCnB0dF9kdG0gPC0gcHR0X3JlbW92ZWQgJT4lIGNhc3RfZHRtKGFydFVybCwgd29yZCwgY291bnQpCnB0dF9kdG0KYGBgCgojIyMgTERBIOS4u+mhjOWIhuaekApgYGB7cn0KIyBMREHliIbkuLvpoYwKcm93VG90YWxzIDwtIGFwcGx5KHB0dF9kdG0gLCAxLCBzdW0pICNGaW5kIHRoZSBzdW0gb2Ygd29yZHMgaW4gZWFjaCBEb2N1bWVudApwdHRfZHRtIDwtIHB0dF9kdG1bcm93VG90YWxzPiAwLCBdCgpwdHRfbGRhIDwtIExEQShwdHRfZHRtLCBrID0gNiwgY29udHJvbCA9IGxpc3Qoc2VlZCA9IDEwMDApKQojIOeci+WQhOe+pOeahOW4uOeUqOipnuW9mQp0aWR5KHB0dF9sZGEsIG1hdHJpeCA9ICJiZXRhIikgJT4lCiAgZ3JvdXBfYnkodG9waWMpICU+JQogIHRvcF9uKDEwLCBiZXRhKSAlPiUKICB1bmdyb3VwKCkgJT4lCiAgbXV0YXRlKHRvcGljID0gYXMuZmFjdG9yKHRvcGljKSwKICAgICAgICAgdGVybSA9IHJlb3JkZXJfd2l0aGluKHRlcm0sIGJldGEsIHRvcGljKSkgJT4lCiAgZ2dwbG90KGFlcyh0ZXJtLCBiZXRhLCBmaWxsID0gdG9waWMpKSArCiAgZ2VvbV9jb2woc2hvdy5sZWdlbmQgPSBGQUxTRSkgKwogIHRoZW1lKHRleHQgPSBlbGVtZW50X3RleHQoZmFtaWx5ID0gJ1RXLUthaScpKSArCiAgZmFjZXRfd3JhcCh+IHRvcGljLCBzY2FsZXMgPSAiZnJlZSIpICsKICBjb29yZF9mbGlwKCkgKwogIHNjYWxlX3hfcmVvcmRlcmVkKCkKYGBgCgoKYGBge3J9CiMg5L2/55SoTERB6aCQ5ris5q+P56+H5paH56ug55qE5Li76aGMCiMg5ZyodGlkeSBmdW5jdGlvbuS4reS9v+eUqOWPg+aVuCJnYW1tYSLkvoblj5blvpcgdGhldGHnn6npmaPjgIIKcHR0X3RvcGljcyA8LSB0aWR5KHB0dF9sZGEsIG1hdHJpeD0iZ2FtbWEiKSAlPiUgCiAgICAgICAgICAgICAgICAgIGdyb3VwX2J5KGRvY3VtZW50KSAlPiUKICAgICAgICAgICAgICAgICAgdG9wX24oMSwgd3Q9Z2FtbWEpCnB0dF90b3BpY3MKYGBgCgoKIyMjIExEQeS4u+mhjOmAsuihjOimluimuuWMlgpgYGB7cn0KIyDmiormlofnq6Dos4foqIrlkozkuLvpoYxqb2lu6LW35L6GCnBvc3RzX1Jldmlld3MgPC0gbWVyZ2UoeCA9IHBvc3RzX1Jldmlld3MsIHkgPSBwdHRfdG9waWNzLCBieS54ID0gImNhbm9uaWNhbF91cmwiLCBieS55PSJkb2N1bWVudCIpCnBvc3RzX1Jldmlld3MKYGBgCgpgYGB7cn0KIyDmjJHpgbjlh7oyMDE5LzEy55qE5paH56ug77yMCiMg56+p6YG45pyJ5ZyoMTXnr4fku6XkuIrmlofnq6Dlm57opobogIXvvIwKIyDmrITkvY3lj6rlj5bvvJpjb21tZW50ZXIo6KmV6KuW6ICFKSwgcG9zdGVyKOeZvOaWh+iAhSksIGNhbm9uaWNhbF91cmwo5paH56ug6YCj57WQKSwgdGl0bGUueCjkuLvpoYwpLCByZWFjdGlvbu+8iOaOqOWZk++8iQpsaW5rIDwtIHBvc3RzX1Jldmlld3MgJT4lCiAgICAgIGZpbHRlcihyZWFjdGlvbiAhPSLihpIiKSAlPiUKICAgICAgZ3JvdXBfYnkoY29tbWVudGVyLCBjYW5vbmljYWxfdXJsKSAlPiUgCiAgICAgIGZpbHRlcihuKCk+MTUpICU+JSAKICAgICAgdW5ncm91cCgpICU+JSAKICAgICAgZmlsdGVyKHRvcGljID09IDEgfCB0b3BpYyA9PSA2KSAlPiUgCiAgICAgIHNlbGVjdChjb21tZW50ZXIsIHBvc3RlciwgY2Fub25pY2FsX3VybCwgdGl0bGUueCwgcmVhY3Rpb24pICU+JSAKICAgICAgdW5pcXVlKCkKCmxpbmtbInBvc3RlciJdPC1hcHBseShsaW5rWyJwb3N0ZXIiXSwgMTpsZW5ndGgobGlua1sicG9zdGVyIl0pLCBmdW5jdGlvbih4KSBnc3ViKCIgLioiLCIiLCB4KSkKbGlua1siY29tbWVudGVyIl08LWFwcGx5KGxpbmtbImNvbW1lbnRlciJdLCAxOmxlbmd0aChsaW5rWyJjb21tZW50ZXIiXSksIGZ1bmN0aW9uKHgpIGdzdWIoIiAuKiIsIiIsIHgpKQpsaW5rIDwtIHVuaXF1ZShsaW5rKQpsaW5rCmBgYAoKYGBge3J9CiMg56+p6YG4bGlua+S4reacieWHuuePvueahOS9v+eUqOiAhQoKZmlsdGVyZWRfdXNlciA8LSB1c2VyTGlzdCAlPiUKICAgICAgICAgIGZpbHRlcih1c2VyJWluJWxpbmskY29tbWVudGVyIHwgdXNlciVpbiVsaW5rJHBvc3RlcikgJT4lCiAgICAgICAgICBhcnJhbmdlKGRlc2ModHlwZSkpICU+JSB1bmlxdWUoKQoKZmlsdGVyZWRfdXNlclsidXNlciJdIDwtIGFwcGx5KGZpbHRlcmVkX3VzZXJbInVzZXIiXSwgMTpsZW5ndGgoZmlsdGVyZWRfdXNlclsidXNlciJdKSwgZnVuY3Rpb24oeCkgZ3N1YigiIC4qIiwiIiwgeCkpCmZpbHRlcmVkX3VzZXIgPC0gdW5pcXVlKGZpbHRlcmVkX3VzZXIpCmZpbHRlcmVkX3VzZXIKYGBgCgpgYGB7cn0KIyDlu7rnq4vntrLot6/pl5zkv4IKcmV2aWV3TmV0d29yayA8LSBncmFwaF9mcm9tX2RhdGFfZnJhbWUoZD1saW5rLCB2PWZpbHRlcmVkX3VzZXIsIGRpcmVjdGVkPVQpCgojIOWIqumZpGRlZ3JlZSA8IDEwIOeahOeUqOaItgpyZXZpZXdOZXR3b3JrIDwtIGRlbGV0ZS52ZXJ0aWNlcyhyZXZpZXdOZXR3b3JrLCBWKHJldmlld05ldHdvcmspWyBkZWdyZWUocmV2aWV3TmV0d29yaykgPCAxMF0pCgojIOS+neaTmuS9v+eUqOiAhei6q+S7veWwjem7numAsuihjOS4iuiJsgpsYWJlbHMgPC0gZGVncmVlKHJldmlld05ldHdvcmspClYocmV2aWV3TmV0d29yaykkbGFiZWwgPC0gbmFtZXMobGFiZWxzKQpWKHJldmlld05ldHdvcmspJGNvbG9yIDwtIGlmZWxzZShWKHJldmlld05ldHdvcmspJHR5cGU9PSJwb3N0ZXIiLCAiZ29sZCIsICJsaWdodGJsdWUiKQoKIyDkvp3mk5rkvb/nlKjogIXlj43mh4nlsI3pgorpgLLooYzkuIroibIKRShyZXZpZXdOZXR3b3JrKSRjb2xvciA8LSBpZmVsc2UoRShyZXZpZXdOZXR3b3JrKSRyZWFjdGlvbiA9PSAi5o6oIiwgImxpZ2h0Z3JlZW4iLCAicGFsZXZpb2xldHJlZCIpCgojIOeVq+WHuuekvue+pOe2sui3r+WclgpzZXQuc2VlZCg1NDMxKQpwbG90KHJldmlld05ldHdvcmssIHZlcnRleC5zaXplPTUsIGVkZ2UuYXJyb3cuc2l6ZT0uMiwgZWRnZS53aWR0aD0uNCwKICAgICB2ZXJ0ZXgubGFiZWw9IE5BLCB2ZXJ0ZXgubGFiZWwuZm9udD0yKQoKIyDliqDlhaXmqJnnpLoKbGVnZW5kKCJib3R0b21yaWdodCIsIGMoImF1dGhvciIsInJldmlld2VyIiksIHBjaD0yMSwKICBjb2w9IiM3Nzc3NzciLCBwdC5iZz1jKCJnb2xkIiwibGlnaHRibHVlIiksIHB0LmNleD0xLCBjZXg9MSkKbGVnZW5kKCJ0b3BsZWZ0IiwgYygiTGlrZSIsIkJvbyIpLCAKICAgICAgIGNvbD1jKCJsaWdodGdyZWVuIiwicGFsZXZpb2xldHJlZCIpLCBsdHk9MSwgY2V4PTEpCmBgYAoKYGBge3J9CiMg55Wr5Ye656S+576k57ay6Lev5ZyW77yM5ZCM5LiK77yM5Y+q5piv5pyJbGFiZWwKc2V0LnNlZWQoNTQzMSkKcGxvdChyZXZpZXdOZXR3b3JrLCB2ZXJ0ZXguc2l6ZT01LCBlZGdlLmFycm93LnNpemU9LjIsIGVkZ2Uud2lkdGg9LjQsCiAgICAgdmVydGV4LmxhYmVsPSBpZmVsc2UoZGVncmVlKHJldmlld05ldHdvcmspID4gMjAsIFYocmV2aWV3TmV0d29yaykkbGFiZWwsIE5BKSwgdmVydGV4LmxhYmVsLmZvbnQ9MikKCiMg5Yqg5YWl5qiZ56S6CmxlZ2VuZCgiYm90dG9tcmlnaHQiLCBjKCJhdXRob3IiLCJyZXZpZXdlciIpLCBwY2g9MjEsCiAgY29sPSIjNzc3Nzc3IiwgcHQuYmc9YygiZ29sZCIsImxpZ2h0Ymx1ZSIpLCBwdC5jZXg9MSwgY2V4PTEpCmxlZ2VuZCgidG9wbGVmdCIsIGMoIkxpa2UiLCJCb28iKSwgCiAgICAgICBjb2w9YygibGlnaHRncmVlbiIsInBhbGV2aW9sZXRyZWQiKSwgbHR5PTEsIGNleD0xKQpgYGA=